home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue72 / terminal / MainForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-03  |  9.3 KB  |  322 lines
  1. unit MainForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, StdCtrls, Menus, ExtCtrls, Db, DBTables;
  8.  
  9. Const
  10.   WM_GATHERSYSINFO = WM_USER+1000;
  11.  
  12. type
  13.   TTSIMainForm = class(TForm)
  14.     PageControl1: TPageControl;
  15.     TabSheet1: TTabSheet;
  16.     SysInfo: TMemo;
  17.     TabSheet2: TTabSheet;
  18.     GroupBox1: TGroupBox;
  19.     Label1: TLabel;
  20.     CurrentProcessID: TEdit;
  21.     Label2: TLabel;
  22.     ConvertProcessID: TEdit;
  23.     ShowSession: TButton;
  24.     MainMenu1: TMainMenu;
  25.     Information1: TMenuItem;
  26.     RefreshSystemInfo1: TMenuItem;
  27.     N1: TMenuItem;
  28.     Exit1: TMenuItem;
  29.     GroupBox2: TGroupBox;
  30.     SessionRefreshTimer: TTimer;
  31.     TSSessions: TListView;
  32.     ShowSessionInfo: TButton;
  33.     RefreshSessions: TCheckBox;
  34.     SendMsgToSession: TButton;
  35.     TabSheet3: TTabSheet;
  36.     ProcessList: TListView;
  37.     RefreshProcesses: TButton;
  38.     ProcessCount: TLabel;
  39.     TabSheet4: TTabSheet;
  40.     GroupBox3: TGroupBox;
  41.     CreateMutex: TButton;
  42.     OpenMutex: TButton;
  43.     Label3: TLabel;
  44.     MutexNamePrefix: TComboBox;
  45.     GroupBox4: TGroupBox;
  46.     Label4: TLabel;
  47.     BDEAlias: TComboBox;
  48.     Label5: TLabel;
  49.     SQLStatement: TMemo;
  50.     ExecuteQuery: TButton;
  51.     CloseMutex: TButton;
  52.     SQLQuery: TQuery;
  53.     procedure FormShow(Sender: TObject);
  54.     procedure ShowSessionClick(Sender: TObject);
  55.     procedure RefreshSystemInfo1Click(Sender: TObject);
  56.     procedure Exit1Click(Sender: TObject);
  57.     procedure SessionRefreshTimerTimer(Sender: TObject);
  58.     procedure ShowSessionInfoClick(Sender: TObject);
  59.     procedure SendMsgToSessionClick(Sender: TObject);
  60.     procedure RefreshProcessesClick(Sender: TObject);
  61.     procedure CreateMutexClick(Sender: TObject);
  62.     procedure OpenMutexClick(Sender: TObject);
  63.     procedure CloseMutexClick(Sender: TObject);
  64.     procedure ExecuteQueryClick(Sender: TObject);
  65.   private
  66.     { Private declarations }
  67.     Mutex : THandle;
  68.     Procedure GatherSysInfo(Var Msg); Message WM_GATHERSYSINFO;
  69.   public
  70.     { Public declarations }
  71.   end;
  72.  
  73. var
  74.   TSIMainForm: TTSIMainForm;
  75.  
  76. implementation
  77.  
  78. uses SystemInfo, TerminalServices, TypInfo;
  79.  
  80. {$R *.DFM}
  81.  
  82. procedure TTSIMainForm.FormShow(Sender: TObject);
  83. begin
  84.   PageControl1.ActivePageIndex := 0;
  85.   PostMessage(Handle,WM_GATHERSYSINFO,0,0);
  86.   CurrentProcessID.Text := IntToStr(GetCurrentProcessId);
  87. end;
  88.  
  89. procedure TTSIMainForm.GatherSysInfo(var Msg);
  90. begin
  91.   With SysInfo,Lines do Begin
  92.     Clear;
  93.     Add(GetTerminalServicesInfo); Add('');
  94.     Add(GetSystemInfo);           Add('');
  95.     Add(GetTimeAndDateInfo);      Add('');
  96.     Add(GetKeyboardLayoutInfo);   Add('');
  97.     Add(GetAudioDeviceInfo);      Add('');
  98.     Add(GetMiscInfo);             Add('');
  99.     Add(GetWinSockInfo);          Add('');
  100.     Add(GetInternetConnectionInfo);
  101.     { bring cursor back to top }
  102.     SelStart := 0;
  103.     Perform(EM_SCROLLCARET,0,0);
  104.   End;
  105. end;
  106.  
  107. procedure TTSIMainForm.ShowSessionClick(Sender: TObject);
  108. Var SessionID : Integer;
  109. begin
  110.   If (Not ProcessIdToSessionId(StrToInt(ConvertProcessID.Text),SessionID)) Then
  111.     RaiseLastWin32Error;
  112.   ShowMessage('Process ID: '+ConvertProcessID.Text+#13+
  113.               'Session ID: '+IntToStr(SessionID));
  114. end;
  115.  
  116. procedure TTSIMainForm.RefreshSystemInfo1Click(Sender: TObject);
  117. begin
  118.   PageControl1.ActivePageIndex := 0;
  119.   SysInfo.Lines.Text := 'Please wait...';
  120.   PostMessage(Handle,WM_GATHERSYSINFO,0,0);
  121. end;
  122.  
  123. procedure TTSIMainForm.Exit1Click(Sender: TObject);
  124. begin
  125.   Close;
  126. end;
  127.  
  128. procedure TTSIMainForm.SessionRefreshTimerTimer(Sender: TObject);
  129. Var
  130.   S   : String;
  131.   P   : PSessionInfoArray;
  132.   I,J : Integer;
  133.   TI  : Pointer;
  134.  
  135. begin
  136.   If (Not RefreshSessions.Checked) Then Exit;
  137.   { update session states }
  138.   If (Not WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE,0,1,P,I)) Then Begin
  139.     SessionRefreshTimer.Enabled := False;
  140.     PageControl1.ActivePageIndex := 1;
  141.     TSSessions.SetFocus;
  142.     RaiseLastWin32Error;
  143.   End;
  144.   TSSessions.Items.Clear;
  145.   For J := 0 to I-1 do Begin
  146.   {$R-}
  147.     TI := TypeInfo(TConnectState);
  148.     S := GetEnumName(TI,Integer(P^[J].State));
  149.     With TSSessions.Items.Add do Begin
  150.       Caption := IntToStr(P^[J].SessionID);
  151.       SubItems.Add(P^[J].WindowStation);
  152.       SubItems.Add(S);
  153.     End;
  154.   {$R+}
  155.   End;
  156.   WTSFreeMemory(P);
  157. end;
  158.  
  159. procedure TTSIMainForm.ShowSessionInfoClick(Sender: TObject);
  160. Const
  161.   InfoNames : Array[WTSInitialProgram..WTSClientProtocolType] of String =
  162.               ('Initial Program','Application Name','Working Directory',
  163.                'OEM ID','Session ID','User Name','Window Station Name',
  164.                'Domain Name','Connect State','Client Build Number',
  165.                'Client Name','Client Directory','Client Product ID',
  166.                'Client Hardware ID','Client Address Family',
  167.                'Client Display','Client ProtocolType');
  168.  
  169. Var
  170.   Session : LongWord;
  171.   Info    : TInfoClass;
  172.   Buf     : Pointer;
  173.   S,T     : String;
  174.   I       : Integer;
  175.  
  176. begin
  177.   If (TSSessions.Selected = nil) Then Session := WTS_CURRENT_SESSION
  178.   Else Session := StrToInt(TSSessions.Selected.Caption);
  179.   { call WTSQuerySessionInformation repeatedly }
  180.   S := '';
  181.   For Info := WTSInitialProgram to WTSClientProtocolType do Begin
  182.     If (Not WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE,
  183.       Session,Info,Buf,I)) Then RaiseLastWin32Error;
  184.     S := S+InfoNames[Info]+': ';
  185.     If (Buf <> nil) Then Begin
  186.       Case Info of
  187.         WTSApplicationName,
  188.         WTSClientDirectory,
  189.         WTSClientName,
  190.         WTSDomainName,
  191.         WTSInitialProgram,
  192.         WTSOEMId,
  193.         WTSUserName,
  194.         WTSWinStationName,
  195.         WTSWorkingDirectory   : S := S+PChar(Buf)+#13;
  196.         WTSClientBuildNumber,
  197.         WTSClientHardwareId,
  198.         WTSConnectState,
  199.         WTSClientAddress,
  200.         WTSSessionId          : S := S+IntToStr(PInteger(Buf)^)+#13;
  201.         WTSClientProductId,
  202.         WTSClientProtocolType : S := S+IntToStr(PByte(Buf)^)+#13;
  203.         WTSClientDisplay      : Begin
  204.                                   T := IntToStr(PInteger(Buf)^)+' x ';
  205.                                   Buf := Pointer(Integer(Buf)+SizeOf(Integer));
  206.                                   T := T+IntToStr(PInteger(Buf)^)+' @ ';
  207.                                   Buf := Pointer(Integer(Buf)+SizeOf(Integer));
  208.                                   T := T+IntToStr(PInteger(Buf)^)+'-bit';
  209.                                   S := S+T+#13;
  210.                                 End;
  211.       End;
  212.       WTSFreeMemory(Buf);
  213.     End;  
  214.   End;
  215.   ShowMessage(S);
  216. end;
  217.  
  218. procedure TTSIMainForm.SendMsgToSessionClick(Sender: TObject);
  219. Var
  220.   Session  : LongWord;
  221.   Title    : String;
  222.   AMessage : String;
  223.   I        : Integer;
  224.  
  225. begin
  226.   If (TSSessions.Selected = nil) Then Begin
  227.     ShowMessage('Please select a session first.');
  228.     Exit;
  229.   End;
  230.   Session := StrToInt(TSSessions.Selected.Caption);
  231.   Title := 'Hello Session #'+IntToStr(Session);
  232.   AMessage := 'It is now: '+DateTimeToStr(Now);
  233.   If (Not WTSSendMessage(WTS_CURRENT_SERVER_HANDLE,Session,
  234.     PChar(Title),Length(Title),PChar(AMessage),Length(AMessage),MB_OK,
  235.     0,I,False)) Then RaiseLastWin32Error;
  236.   ShowMessage('Message sent.');
  237. end;
  238.  
  239. Function SIDToUserName(SID : PSID) : String;
  240. Var
  241.   Name  : Array[0..256] of Char;
  242.   NLen  : Cardinal;
  243.   Dom   : Array[0..256] of Char;
  244.   DLen  : Cardinal;
  245.   SType : Cardinal;
  246.  
  247. begin
  248.   If (SID = nil) Then Result := 'SYSTEM'
  249.   Else Begin
  250.     NLen := SizeOf(Name);
  251.     DLen := SizeOf(Dom);
  252.     If (Not LookupAccountSid(nil,SID,Name,NLen,Dom,DLen,SType)) Then
  253.       Result := '(unknown)'
  254.     Else Result := StrPas(Name);
  255.   End;
  256. end;
  257.  
  258. procedure TTSIMainForm.RefreshProcessesClick(Sender: TObject);
  259. Var
  260.   P   : PProcessInfoArray;
  261.   I,J : Integer;
  262.  
  263. begin
  264.   If (Not WTSEnumerateProcesses(WTS_CURRENT_SERVER_HANDLE,0,1,P,I)) Then
  265.     RaiseLastWin32Error;
  266.   ProcessList.Items.Clear;
  267.   ProcessCount.Caption := IntToStr(I)+' processes shown';
  268.   For J := 0 to I-1 do Begin
  269.   {$R-}
  270.     With ProcessList.Items.Add do Begin
  271.       Caption := IntToStr(P^[J].ProcessID);
  272.       SubItems.Add(IntToStr(P^[J].SessionID));
  273.       If (P^[J].ProcessName = nil) Then SubItems.Add('-')
  274.       Else SubItems.Add(P^[J].ProcessName);
  275.       SubItems.Add(SIDToUserName(P^[J].UserSID));
  276.     End;
  277.   {$R+}
  278.   End;
  279.   WTSFreeMemory(P);
  280. end;
  281.  
  282. procedure TTSIMainForm.CreateMutexClick(Sender: TObject);
  283. begin
  284.   Mutex := Windows.CreateMutex(nil,False,
  285.            PChar(MutexNamePrefix.Text+'terminalserviceinfo-mutex-1.0'));
  286.   If (Mutex <> 0) Then ShowMessage('Mutex created.')
  287.   Else RaiseLastWin32Error;
  288. end;
  289.  
  290. procedure TTSIMainForm.OpenMutexClick(Sender: TObject);
  291. begin
  292.   Mutex := Windows.OpenMutex(MUTEX_ALL_ACCESS,False,
  293.            PChar(MutexNamePrefix.Text+'terminalserviceinfo-mutex-1.0'));
  294.   If (Mutex = 0) Then RaiseLastWin32Error;
  295.   ShowMessage('Mutex opened OK.');         
  296. end;
  297.  
  298. procedure TTSIMainForm.CloseMutexClick(Sender: TObject);
  299. begin
  300.   If (Mutex = 0) Then ShowMessage('Nothing to close.')
  301.   Else Begin
  302.     CloseHandle(Mutex);
  303.     Mutex := 0;
  304.     ShowMessage('Mutex closed.');
  305.   End;
  306. end;
  307.  
  308. procedure TTSIMainForm.ExecuteQueryClick(Sender: TObject);
  309. begin
  310.   With SQLQuery do Begin
  311.     Close;
  312.     DatabaseName := BDEAlias.Text;
  313.     SQL.Assign(SQLStatement.Lines);
  314.     Open;
  315.     Last;
  316.     ShowMessage('Query executed, '+IntToStr(RecordCount)+' rows.');
  317.     Close;
  318.   End;
  319. end;
  320.  
  321. end.
  322.